home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
WINMX Assorted Textfiles
/
Ebooks.tar
/
Text - Tech - Programming - Visual Basic - Nod Programing VB Help Index 3 (TXT).zip
/
VBTips3.txt
Wrap
Text File
|
1998-02-06
|
12KB
|
386 lines
Nod Programing VB Help Index
»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
This is intended for free use. The code here is for various skill levels,
anyone from beginers to advanced programers can use these. Do what you wish
with the code it is free for you to use and manipulate!
****************************************************************************
Simple input validation:
Here's a way to achieve validation in text boxes and other controls that
support the KeyPress event. It's simple, but functional.
First, add this function to your project:
Function ValiText(KeyIn As Integer, _ValidateString As String, _Editable
As Boolean) As Integer
Dim ValidateList As String
Dim KeyOut As Integer
'
If Editable = True Then
ValidateList = UCase(ValidateString) & Chr(8)
Else
ValidateList = UCase(ValidateString)
End If
'
If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
KeyOut = KeyIn
Else
KeyOut = 0
Beep
End If
'
ValiText = KeyOut
'
End Function
Then, for each control whose input you wish to validate, just put something
like this in the KeyPress event of the control:
KeyAscii=ValiText(Keyascii, "0123456789/-",True)
Doing so will filter out any undesired keys that go to the control,
accepting only the keys defined by the second parameter. In this case, that
parameter ("0123456789/-") defines characters that are valid for a date.
The function's third parameter controls whether the [Backspace] key can be
used.
Note that this implementation of the function ignores the case of the
incoming keys, so if your second parameter were "abcdefg", the function
would also allow "ABCDEFG" to be entered.
****************************************************************************
Simplying the addition of items to ComboBoxes:
I often need to add items to a ComboBox and store an index or ID value in
the ItemData property. I've found that the code needed to add items to the
ComboBox and to check the ItemData property of the currently selected item
looks clumsy. So, I've written two simple helper routines to clean the code
up a bit. Here they are:
'---------------------------------------------------------------------------
' AddComboItem
' AddComboItem
'---------------------------------------------------------------------------
Public Sub AddComboItem( _cboAdd As ComboBox, _ByVal sText As String,
_ByVal lData As Long)
cboAdd.AddItem sText
cboAdd.ItemData(cboAdd.NewIndex) lData
End Sub
'---------------------------------------------------------------------------
' CurrComboData
' CurrComboData
'---------------------------------------------------------------------------
Public Function CurrComboData( _cbo As ComboBox) As Long
If cbo.ListIndex <> -1 Then
CurrComboData = cbo.ItemData(cbo.ListIndex)
Else
CurrComboData = -1
End If
End Function
Now, instead of writing
cboTest.AddItem "Hello"
cboTest.ItemData(cboTest.NewIndex) = 5
you can just write
AddComboItem cboTest, "Hello",5
Instead of writing
ID = cboTest.ItemData(cboTest.ListIndex)
you can write
ID = CurrComboData( cboTest )
As an added bonus, CurrComboData protects you from the runtime error
generated if ListIndex is -1. Just be sure to check for a return of -1 from
CurrComboData.
****************************************************************************
Showing long ListBox entries as a ToolTip:
Sometimes the data you want to display in a list is too long for the size
of ListBox you can use. When this happens, you can use some simple code to
display the ListBox entries as ToolTips when the mouse passes over the
ListBox.
First, start a new VB project and add a ListBox to the default form. Then
declare the SendMessage API call and the constant (LB_ITEMFROMPOINT) needed
for the operation:
Option Explicit
'Declare the API function call.
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
' Add API constant
Private Const LB_ITEMFROMPOINT = &H1A9
Next, add some code to the form load event to fill the ListBox with data:
Private Sub Form_Load()
'
' load some items in the list box
With List1
.AddItem "Michael Clifford Amundsen"
.AddItem "Walter P.K. Smithworthy, III"
.AddItem "Alicia May Sue McPherson-Pennington"
End With
'
End Sub
Finally, in the MouseMove event of the ListBox, put the following code:
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
'
' present related tip message
'
Dim lXPoint As Long
Dim lYPoint As Long
Dim lIndex As Long
'
If Button = 0 Then ' if no button was pressed
lXPoint = CLng(X / Screen.TwipsPerPixelX)
lYPoint = CLng(Y / Screen.TwipsPerPixelY)
'
With List1
' get selected item from list
lIndex = SendMessage(.hwnd, _
LB_ITEMFROMPOINT, _
0, _
ByVal ((lYPoint * 65536) + lXPoint))
' show tip or clear last one
If (lIndex >= 0) And (lIndex <= .ListCount) Then
.ToolTipText = .List(lIndex)
Else
.ToolTipText = ""
End If
End With '(List1)
End If '(button=0)
'
End Sub
****************************************************************************
Creating Short Arrays Using the Variant Data Type:
If you need to create a short list of items in an array, you can save a lot
of coding by using the Variant data type instead of a dimensioned standard
data type. This is especially handy when you need to create a list of short
phrases to support numeric output.
For example, add a button to a standard VB form and paste the following
code into the Click event of the button:
Private Sub Command1_Click()
'
' create a quick array using variants
'
Dim aryList As Variant
'
aryList = Array("No Access", "Read-Only", "Update", "Delete")
'
MsgBox aryList(2)
'
End Sub
****************************************************************************
Using GetRows to Quickly Save Data Fields to Memory Variables:
If you need to copy information from database fields into memory variables,
you can do it quickly using the GetRows method of the Recordset object. The
GetRows method copies one or more rows of data directly into a Variant data
type and stores the information as a two-dimensional array in the
formvarData(Field,Column).
To test the GetRow method, add a button to a VB form and paste the
following code into the Click event of the button. Be sure to fix the
reference to location of the BIBLIO.MDB database in the OpenDatabase
method. Also be sure to set up a reference to the Microsoft DAO 3.5 Object
Library.
Private Sub cmdGetDataRow_Click()
'
' show getrow method
'
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
'
Dim varDataRows As Variant
Dim intRows As Integer
Dim intColumns As Integer
'
Dim intLoopRow As Integer
Dim intLoopCol As Integer
Dim strMsg As String
'
Set ws = DBEngine.CreateWorkspace(App.EXEName, "admin", "")
Set db = ws.OpenDatabase("e:\devstudio\vb\biblio.mdb")
Set rs = db.OpenRecordset("SELECT * FROM Authors")
'
intRows = InputBox("How Many Rows?", "GetRows Example", 0)
intColumns = rs.Fields.Count
varDataRows = rs.GetRows(intRows)
'
For intLoopRow = 0 To intRows - 1
strMsg = ""
For intLoopCol = 0 To intColumns - 1
strMsg = strMsg & varDataRows(intLoopCol, intLoopRow) & vbCrLf
Next
MsgBox strMsg
Next
'
rs.Close
db.Close
ws.Close
'
End Sub
****************************************************************************
Getting sensible Win32 API call errors:
Most of the Win32 API calls return extended error information when they
fail. To get this information in a sensible format, you can use the
GetLastError and FormatMessage APIs.
Add the following declarations and function to a BAS module in a VB project:
Option Explicit
Public Declare Function GetLastError _
Lib "kernel32" () As Long
Public Declare Function FormatMessage _
Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Function LastSystemError() As String
'
' better system error
'
Dim sError As String * 500
Dim lErrNum As Long
Dim lErrMsg As Long
'
lErrNum = GetLastError
lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, lErrNum, 0, sError, Len(sError), 0)
LastSystemError = Trim(sError)
'
End Function
Now place a command button on a standard VB form and call the
LastSystemError function:
Private Sub Command1_Click()
'
MsgBox LastSystemError
'
End Sub
If there was no error registered, you'll see a message saying "The
operation completed successfully."
When using this function, keep these points in mind:
1. Many API calls reset the value of GetLastError when successful, so the
function must be called immediately after the API call that failed.
2. The last error value is kept on a per-thread basis, therefore the
function must be called from the same thread as the API call that failed.
****************************************************************************
Increment and decrement dates with the [+] and [-] keys:
If you've ever used Quicken, you've probably notice a handy little feature
in that program's date fields. You can press the [+] key to increment one
day, [-] to decrement one day, [PgUp] to increment one month, and [PgDn] to
decrement one month. In this tip, we'll show you how to emulate this
behavior with Visual Basic.
First, insert a text box on a form (txtDate). Set its text property to ""
and its Locked property to TRUE.
Now place the following code in the KeyDown event:
Private Sub txtDate_KeyDown(KeyCode As Integer, Shift As Integer)
'
' 107 = "+" KeyPad
' 109 = "-" KeyPad
' 187 = "+" (Actually this is the "=" key, same as "+" w/o the=
shift)
' 189 = "-"
' 33 = PgUp
' 34 = PgDn
'
Dim strYear As String
Dim strMonth As String
Dim strDay As String
'
If txtDate.Text = "" Then
txtDate.Text = Format(Now, "m/d/yyyy")
Exit Sub
End If
'
strYear = Format(txtDate.Text, "yyyy")
strMonth = Format(txtDate.Text, "mm")
strDay = Format(txtDate.Text, "dd")
'
Select Case KeyCode
Case 107, 187 ' add a day
txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) +
1, "m/d/yyyy")
Case 109, 189 ' subtract a day
txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) -
1, "m/d/yyyy")
Case 33 ' add a month
txtDate.Text = Format(DateSerial(strYear, strMonth + 1,
strDay), "m/d/yyyy")
Case 34 ' subtract a month
txtDate.Text = Format(DateSerial(strYear, strMonth - 1,
strDay), "m/d/yyyy")
End Select
'
End Sub
The one nasty thing about this is that if you have characters that are not
the characters usually in a date (i.e., 1-9, Monday, Tuesday, or /) you get
errors in the format command. To overcome this, I set the Locked property
to True. This way, the user can't actually type a character in the field,
but the KeyDown event still fires.
End of Help 3 of how many I do!!